home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus 1995 #5 & #6
/
Amiga Plus CD - 1995 - No. 5 and 6.iso
/
pd
/
serien
/
purity
/
nr.51
/
membar
/
mem.p
< prev
next >
Wrap
Text File
|
1995-08-27
|
4KB
|
156 lines
Program MemBar;
{ Graphische Speicheranzeige auf der Workbench }
{ PUBLIC DOMAIN - 1995 Andreas Tetzl }
{ EMail: A.Tetzl@saxonia.de }
{ Beenden: CTRL c
Klick mit linker Maustaste auf Balken, Doppelklick
mit rechter Maustaste
}
{ /// ------------------------------ "Includes" ------------------------------ }
{$I "Include:Exec/Libraries.i"}
{$I "Include:Exec/Memory.i"}
{$I "Include:Intuition/Intuition.i"}
{$I "Include:Intuition/Screens.i"}
{$I "Include:Graphics/Graphics.i"}
{$I "Include:Graphics/Pens.i"}
{$I "Include:Utility/Utility.i"}
{$I "Include:DOS/DOS.i"}
{$I "Include:Utils/TagUtils.i"}
{$I "Include:Utils/Break.i"}
{ /// ------------------------------------------------------------------------ }
{ /// -------------------------------- "VAR" --------------------------------- }
const
StdInName = NIL;
StdOutName = NIL;
BACKCOL = 2;
FULLCOL = 3;
EMPTYCOL = 0;
BARWIDTH = 150;
version = "$VER: MemBar v1.0 (5.7.95)";
VAR Win : WindowPtr;
Scr : ScreenPtr;
TagList : Address;
RP : RastPortPtr;
mem, oldmem, total, i : Integer;
s, m : Integer;
Msg : IntuiMessagePtr;
{ /// ------------------------------------------------------------------------ }
{ /// --------------------------- "PROCEDURE Req" ---------------------------- }
PROCEDURE Req(Txt : String);
const
es : EasyStruct = (0,0,NIL,NIL,NIL);
VAR i : Integer;
begin
es.es_StructSize:=SizeOf(EasyStruct);
es.es_Flags:=0;
es.es_Title:="Information";
es.es_TextFormat:=Txt;
es.es_GadgetFormat:="OK";
i:=EasyRequestArgs(NIL,adr(es),0,NIL);
END;
{ /// ------------------------------------------------------------------------ }
{ /// ------------------------ "PROCEDURE CleanExit" ------------------------- }
PROCEDURE CleanExit(Why : String; RC : Integer);
BEGIN
If Win<>NIL then CloseWindow(Win);
If GfxBase<>NIL then CloseLibrary(GfxBase);
If UtilityBase<>NIL then CloseLibrary(UtilityBase);
If Why<>NIL then Req(Why);
Exit(RC);
END;
{ /// ------------------------------------------------------------------------ }
{ /// ------------------------- "PROCEDURE OpenAll" -------------------------- }
PROCEDURE OpenAll;
BEGIN
UtilityBase:=OpenLibrary("utility.library",37);
If UtilityBase=NIL then CleanExit("CANT OPEN UTILITY",10);
GfxBase:=OpenLibrary("graphics.library",37);
IF GfxBase=NIL then CleanExit("CANT OPEN GFX",10);
Scr:=LockPubScreen(NIL);
If Scr=NIL then CleanExit("CANT FIND WB",10);
TagList:=CreateTagList(WA_Left,Scr^.Width-BARWIDTH-26,
WA_Top,0,
WA_Width,BARWIDTH,
WA_Height,Scr^.BarHeight,
WA_Borderless,TRUE,
WA_IDCMP,IDCMP_MENUPICK,
TAG_END);
Win:=OpenWindowTagList(NIL,TagList);
FreeTagItems(TagList);
If Win=NIL then CleanExit("Can't open window",10);
RP:=Win^.RPort;
SetRast(RP,BACKCOL);
total:=AvailMem(MEMF_TOTAL);
END;
{ /// ------------------------------------------------------------------------ }
{ /// -------------------------------- "Main" -------------------------------- }
BEGIN
OpenAll;
Repeat
mem:=total-AvailMem(MEMF_CHIP)-AvailMem(MEMF_FAST);
If Abs(mem-oldmem)>1024 then
BEGIN
SetAPen(RP,EMPTYCOL);
RectFill(RP,1,2,Win^.Width-2,Win^.Height-3);
SetAPen(RP,FULLCOL);
RectFill(RP,1,2,(Win^.Width-2)*mem/total,Win^.Height-3);
END;
oldmem:=mem;
Delay(50);
Msg:=IntuiMessagePtr(GetMsg(Win^.UserPort));
If Msg<>NIL then
BEGIN
If DoubleClick(s,m,Msg^.Seconds,Msg^.Micros) then
BEGIN
ReplyMsg(MessagePtr(Msg));
CleanExit(NIL,0);
END;
ReplyMsg(MessagePtr(Msg));
s:=Msg^.Seconds;
m:=Msg^.Micros;
END;
Until CheckBreak;
CleanExit(NIL,0);
END.
{ /// ------------------------------------------------------------------------ }